home *** CD-ROM | disk | FTP | other *** search
- ; ================================================================
- ; Listing 3: Global Text Editor B. Kramer
- ;
- ; Edit text generation characteristics in graphics editor.
- ;
- ; CADENCE Tutorial Application #8
- ;
- ; Variables:
- ; S1 Selection set
- ; User User entry string
- ; Elist Entity list (from selection set accessing)
- ; New New variable data from user
- ;
- ; ================================================================
- (defun c:GTCHANGE ()
- (setq S1 nil) (gc) ; Clear Selection set for use.
- (prompt "\nSelect text objects:")
- (setq S1 (ssget))
- (ss-sieve S1 "TEXT") ; Utility routine from Listing 2.
- (setq User "Go")
- (while (/= User "Exit")
- (setq User
- (strcase
- (getstring "\nChange: Style/Height/Oblq angle/Rot angle/ <eXit>:")))
- (if (> (strlen User) 1) (setq User (substr User 1 1)))
- (cond
- ((and (/= User "X") (/= User ""))
- (setq Code
- (cond
- ((= User "S") 7)
- ((= User "H") 40)
- ((= User "O") 51)
- ((= User "R") 50)
- (t nil)))
- (cond
- ((boundp 'Code)
- (setq New (getstring "\nNew value:"))
- (if (> Code 20) (setq New (atof New)))
- (if (and (> Code 49) (< Code 60))
- (setq New (* (/ New 180.0) pi)))
- (setq CNT -1)
- (repeat (sslength S1)
- (setq Elist (entget (ssname S1 (setq CNT (1+ CNT)))))
- (entmod
- (cond
- ((null (assoc Code Elist))
- (append Elist (list (cons Code New))))
- (t
- (subst (cons Code New) (assoc Code Elist) Elist)
- )
- )
- )
- )
- )
- (t (prompt "\nEntry invalid:")))
- )
- (t
- (setq User "Exit")))))
- ; ===============================================================
- ;
- ; Removes entities from selection set that are not equal to the
- ; entity type name passed as parameter two.
- ;
- ; (ss-sieve S1 Screen) Programming Utility Routine
- ;
- ; Variables:
- ; S1 Selection set
- ; Screen String of entity type to keep {eg: TEXT, LINE,...}
- ; CNT Index into selection set
- ; Elist Current entity list
- ; ===============================================================
- (defun ss-sieve (S1 Screen)
- (setq CNT (sslength S1))
- (while (> CNT 0)
- (setq Elist (entget (ssname S1 (setq CNT (1- CNT)))))
- (cond
- ((/= (cdr (assoc 0 Elist)) Screen)
- (ssdel (ssname S1 CNT) S1)))))
-